home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl / 5.10.1 / Cwd.pm < prev    next >
Encoding:
Perl POD Document  |  2012-12-11  |  16.6 KB  |  649 lines
  1. package Cwd;
  2.  
  3. use strict;
  4. use Exporter;
  5. use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  6.  
  7. $VERSION = '3.30';
  8. my $xs_version = $VERSION;
  9. $VERSION = eval $VERSION;
  10.  
  11. @ISA = qw/ Exporter /;
  12. @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
  13. push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
  14. @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
  15.  
  16. # sys_cwd may keep the builtin command
  17.  
  18. # All the functionality of this module may provided by builtins,
  19. # there is no sense to process the rest of the file.
  20. # The best choice may be to have this in BEGIN, but how to return from BEGIN?
  21.  
  22. if ($^O eq 'os2') {
  23.     local $^W = 0;
  24.  
  25.     *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
  26.     *getcwd             = \&cwd;
  27.     *fastgetcwd         = \&cwd;
  28.     *fastcwd            = \&cwd;
  29.  
  30.     *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
  31.     *abs_path           = \&fast_abs_path;
  32.     *realpath           = \&fast_abs_path;
  33.     *fast_realpath      = \&fast_abs_path;
  34.  
  35.     return 1;
  36. }
  37.  
  38. # Need to look up the feature settings on VMS.  The preferred way is to use the
  39. # VMS::Feature module, but that may not be available to dual life modules.
  40.  
  41. my $use_vms_feature;
  42. BEGIN {
  43.     if ($^O eq 'VMS') {
  44.         if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
  45.             $use_vms_feature = 1;
  46.         }
  47.     }
  48. }
  49.  
  50. # Need to look up the UNIX report mode.  This may become a dynamic mode
  51. # in the future.
  52. sub _vms_unix_rpt {
  53.     my $unix_rpt;
  54.     if ($use_vms_feature) {
  55.         $unix_rpt = VMS::Feature::current("filename_unix_report");
  56.     } else {
  57.         my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
  58.         $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
  59.     }
  60.     return $unix_rpt;
  61. }
  62.  
  63. # Need to look up the EFS character set mode.  This may become a dynamic
  64. # mode in the future.
  65. sub _vms_efs {
  66.     my $efs;
  67.     if ($use_vms_feature) {
  68.         $efs = VMS::Feature::current("efs_charset");
  69.     } else {
  70.         my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
  71.         $efs = $env_efs =~ /^[ET1]/i; 
  72.     }
  73.     return $efs;
  74. }
  75.  
  76. # If loading the XS stuff doesn't work, we can fall back to pure perl
  77. eval {
  78.   if ( $] >= 5.006 ) {
  79.     require XSLoader;
  80.     XSLoader::load( __PACKAGE__, $xs_version);
  81.   } else {
  82.     require DynaLoader;
  83.     push @ISA, 'DynaLoader';
  84.     __PACKAGE__->bootstrap( $xs_version );
  85.   }
  86. };
  87.  
  88. # Must be after the DynaLoader stuff:
  89. $VERSION = eval $VERSION;
  90.  
  91. # Big nasty table of function aliases
  92. my %METHOD_MAP =
  93.   (
  94.    VMS =>
  95.    {
  96.     cwd            => '_vms_cwd',
  97.     getcwd        => '_vms_cwd',
  98.     fastcwd        => '_vms_cwd',
  99.     fastgetcwd        => '_vms_cwd',
  100.     abs_path        => '_vms_abs_path',
  101.     fast_abs_path    => '_vms_abs_path',
  102.    },
  103.  
  104.    MSWin32 =>
  105.    {
  106.     # We assume that &_NT_cwd is defined as an XSUB or in the core.
  107.     cwd            => '_NT_cwd',
  108.     getcwd        => '_NT_cwd',
  109.     fastcwd        => '_NT_cwd',
  110.     fastgetcwd        => '_NT_cwd',
  111.     abs_path        => 'fast_abs_path',
  112.     realpath        => 'fast_abs_path',
  113.    },
  114.  
  115.    dos => 
  116.    {
  117.     cwd            => '_dos_cwd',
  118.     getcwd        => '_dos_cwd',
  119.     fastgetcwd        => '_dos_cwd',
  120.     fastcwd        => '_dos_cwd',
  121.     abs_path        => 'fast_abs_path',
  122.    },
  123.  
  124.    # QNX4.  QNX6 has a $os of 'nto'.
  125.    qnx =>
  126.    {
  127.     cwd            => '_qnx_cwd',
  128.     getcwd        => '_qnx_cwd',
  129.     fastgetcwd        => '_qnx_cwd',
  130.     fastcwd        => '_qnx_cwd',
  131.     abs_path        => '_qnx_abs_path',
  132.     fast_abs_path    => '_qnx_abs_path',
  133.    },
  134.  
  135.    cygwin =>
  136.    {
  137.     getcwd        => 'cwd',
  138.     fastgetcwd        => 'cwd',
  139.     fastcwd        => 'cwd',
  140.     abs_path        => 'fast_abs_path',
  141.     realpath        => 'fast_abs_path',
  142.    },
  143.  
  144.    epoc =>
  145.    {
  146.     cwd            => '_epoc_cwd',
  147.     getcwd            => '_epoc_cwd',
  148.     fastgetcwd        => '_epoc_cwd',
  149.     fastcwd        => '_epoc_cwd',
  150.     abs_path        => 'fast_abs_path',
  151.    },
  152.  
  153.    MacOS =>
  154.    {
  155.     getcwd        => 'cwd',
  156.     fastgetcwd        => 'cwd',
  157.     fastcwd        => 'cwd',
  158.     abs_path        => 'fast_abs_path',
  159.    },
  160.   );
  161.  
  162. $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
  163.  
  164. # Find the pwd command in the expected locations.  We assume these
  165. # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
  166. # so everything works under taint mode.
  167. my $pwd_cmd;
  168. foreach my $try ('/bin/pwd',
  169.          '/usr/bin/pwd',
  170.          '/QOpenSys/bin/pwd', # OS/400 PASE.
  171.         ) {
  172.  
  173.     if( -x $try ) {
  174.         $pwd_cmd = $try;
  175.         last;
  176.     }
  177. }
  178. my $found_pwd_cmd = defined($pwd_cmd);
  179. unless ($pwd_cmd) {
  180.     # Isn't this wrong?  _backtick_pwd() will fail if somenone has
  181.     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
  182.     # See [perl #16774]. --jhi
  183.     $pwd_cmd = 'pwd';
  184. }
  185.  
  186. # Lazy-load Carp
  187. sub _carp  { require Carp; Carp::carp(@_)  }
  188. sub _croak { require Carp; Carp::croak(@_) }
  189.  
  190. # The 'natural and safe form' for UNIX (pwd may be setuid root)
  191. sub _backtick_pwd {
  192.     # Localize %ENV entries in a way that won't create new hash keys
  193.     my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
  194.     local @ENV{@localize};
  195.     
  196.     my $cwd = `$pwd_cmd`;
  197.     # Belt-and-suspenders in case someone said "undef $/".
  198.     local $/ = "\n";
  199.     # `pwd` may fail e.g. if the disk is full
  200.     chomp($cwd) if defined $cwd;
  201.     $cwd;
  202. }
  203.  
  204. # Since some ports may predefine cwd internally (e.g., NT)
  205. # we take care not to override an existing definition for cwd().
  206.  
  207. unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
  208.     # The pwd command is not available in some chroot(2)'ed environments
  209.     my $sep = $Config::Config{path_sep} || ':';
  210.     my $os = $^O;  # Protect $^O from tainting
  211.  
  212.     # Try again to find a pwd, this time searching the whole PATH.
  213.     if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
  214.     my @candidates = split($sep, $ENV{PATH});
  215.     while (!$found_pwd_cmd and @candidates) {
  216.         my $candidate = shift @candidates;
  217.         $found_pwd_cmd = 1 if -x "$candidate/pwd";
  218.     }
  219.     }
  220.  
  221.     # MacOS has some special magic to make `pwd` work.
  222.     if( $os eq 'MacOS' || $found_pwd_cmd )
  223.     {
  224.     *cwd = \&_backtick_pwd;
  225.     }
  226.     else {
  227.     *cwd = \&getcwd;
  228.     }
  229. }
  230.  
  231. if ($^O eq 'cygwin') {
  232.   # We need to make sure cwd() is called with no args, because it's
  233.   # got an arg-less prototype and will die if args are present.
  234.   local $^W = 0;
  235.   my $orig_cwd = \&cwd;
  236.   *cwd = sub { &$orig_cwd() }
  237. }
  238.  
  239. # set a reasonable (and very safe) default for fastgetcwd, in case it
  240. # isn't redefined later (20001212 rspier)
  241. *fastgetcwd = \&cwd;
  242.  
  243. # A non-XS version of getcwd() - also used to bootstrap the perl build
  244. # process, when miniperl is running and no XS loading happens.
  245. sub _perl_getcwd
  246. {
  247.     abs_path('.');
  248. }
  249.  
  250. # By John Bazik
  251. #
  252. # Usage: $cwd = &fastcwd;
  253. #
  254. # This is a faster version of getcwd.  It's also more dangerous because
  255. # you might chdir out of a directory that you can't chdir back into.
  256.     
  257. sub fastcwd_ {
  258.     my($odev, $oino, $cdev, $cino, $tdev, $tino);
  259.     my(@path, $path);
  260.     local(*DIR);
  261.  
  262.     my($orig_cdev, $orig_cino) = stat('.');
  263.     ($cdev, $cino) = ($orig_cdev, $orig_cino);
  264.     for (;;) {
  265.     my $direntry;
  266.     ($odev, $oino) = ($cdev, $cino);
  267.     CORE::chdir('..') || return undef;
  268.     ($cdev, $cino) = stat('.');
  269.     last if $odev == $cdev && $oino == $cino;
  270.     opendir(DIR, '.') || return undef;
  271.     for (;;) {
  272.         $direntry = readdir(DIR);
  273.         last unless defined $direntry;
  274.         next if $direntry eq '.';
  275.         next if $direntry eq '..';
  276.  
  277.         ($tdev, $tino) = lstat($direntry);
  278.         last unless $tdev != $odev || $tino != $oino;
  279.     }
  280.     closedir(DIR);
  281.     return undef unless defined $direntry; # should never happen
  282.     unshift(@path, $direntry);
  283.     }
  284.     $path = '/' . join('/', @path);
  285.     if ($^O eq 'apollo') { $path = "/".$path; }
  286.     # At this point $path may be tainted (if tainting) and chdir would fail.
  287.     # Untaint it then check that we landed where we started.
  288.     $path =~ /^(.*)\z/s        # untaint
  289.     && CORE::chdir($1) or return undef;
  290.     ($cdev, $cino) = stat('.');
  291.     die "Unstable directory path, current directory changed unexpectedly"
  292.     if $cdev != $orig_cdev || $cino != $orig_cino;
  293.     $path;
  294. }
  295. if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
  296.  
  297. # Keeps track of current working directory in PWD environment var
  298. # Usage:
  299. #    use Cwd 'chdir';
  300. #    chdir $newdir;
  301.  
  302. my $chdir_init = 0;
  303.  
  304. sub chdir_init {
  305.     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
  306.     my($dd,$di) = stat('.');
  307.     my($pd,$pi) = stat($ENV{'PWD'});
  308.     if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
  309.         $ENV{'PWD'} = cwd();
  310.     }
  311.     }
  312.     else {
  313.     my $wd = cwd();
  314.     $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
  315.     $ENV{'PWD'} = $wd;
  316.     }
  317.     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
  318.     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
  319.     my($pd,$pi) = stat($2);
  320.     my($dd,$di) = stat($1);
  321.     if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
  322.         $ENV{'PWD'}="$2$3";
  323.     }
  324.     }
  325.     $chdir_init = 1;
  326. }
  327.  
  328. sub chdir {
  329.     my $newdir = @_ ? shift : '';    # allow for no arg (chdir to HOME dir)
  330.     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
  331.     chdir_init() unless $chdir_init;
  332.     my $newpwd;
  333.     if ($^O eq 'MSWin32') {
  334.     # get the full path name *before* the chdir()
  335.     $newpwd = Win32::GetFullPathName($newdir);
  336.     }
  337.  
  338.     return 0 unless CORE::chdir $newdir;
  339.  
  340.     if ($^O eq 'VMS') {
  341.     return $ENV{'PWD'} = $ENV{'DEFAULT'}
  342.     }
  343.     elsif ($^O eq 'MacOS') {
  344.     return $ENV{'PWD'} = cwd();
  345.     }
  346.     elsif ($^O eq 'MSWin32') {
  347.     $ENV{'PWD'} = $newpwd;
  348.     return 1;
  349.     }
  350.  
  351.     if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
  352.     $ENV{'PWD'} = cwd();
  353.     } elsif ($newdir =~ m#^/#s) {
  354.     $ENV{'PWD'} = $newdir;
  355.     } else {
  356.     my @curdir = split(m#/#,$ENV{'PWD'});
  357.     @curdir = ('') unless @curdir;
  358.     my $component;
  359.     foreach $component (split(m#/#, $newdir)) {
  360.         next if $component eq '.';
  361.         pop(@curdir),next if $component eq '..';
  362.         push(@curdir,$component);
  363.     }
  364.     $ENV{'PWD'} = join('/',@curdir) || '/';
  365.     }
  366.     1;
  367. }
  368.  
  369. sub _perl_abs_path
  370. {
  371.     my $start = @_ ? shift : '.';
  372.     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
  373.  
  374.     unless (@cst = stat( $start ))
  375.     {
  376.     _carp("stat($start): $!");
  377.     return '';
  378.     }
  379.  
  380.     unless (-d _) {
  381.         # Make sure we can be invoked on plain files, not just directories.
  382.         # NOTE that this routine assumes that '/' is the only directory separator.
  383.     
  384.         my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
  385.         or return cwd() . '/' . $start;
  386.     
  387.     # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
  388.     if (-l $start) {
  389.         my $link_target = readlink($start);
  390.         die "Can't resolve link $start: $!" unless defined $link_target;
  391.         
  392.         require File::Spec;
  393.             $link_target = $dir . '/' . $link_target
  394.                 unless File::Spec->file_name_is_absolute($link_target);
  395.         
  396.         return abs_path($link_target);
  397.     }
  398.     
  399.     return $dir ? abs_path($dir) . "/$file" : "/$file";
  400.     }
  401.  
  402.     $cwd = '';
  403.     $dotdots = $start;
  404.     do
  405.     {
  406.     $dotdots .= '/..';
  407.     @pst = @cst;
  408.     local *PARENT;
  409.     unless (opendir(PARENT, $dotdots))
  410.     {
  411.         # probably a permissions issue.  Try the native command.
  412.         return File::Spec->rel2abs( $start, _backtick_pwd() );
  413.     }
  414.     unless (@cst = stat($dotdots))
  415.     {
  416.         _carp("stat($dotdots): $!");
  417.         closedir(PARENT);
  418.         return '';
  419.     }
  420.     if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
  421.     {
  422.         $dir = undef;
  423.     }
  424.     else
  425.     {
  426.         do
  427.         {
  428.         unless (defined ($dir = readdir(PARENT)))
  429.             {
  430.             _carp("readdir($dotdots): $!");
  431.             closedir(PARENT);
  432.             return '';
  433.         }
  434.         $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
  435.         }
  436.         while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
  437.            $tst[1] != $pst[1]);
  438.     }
  439.     $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
  440.     closedir(PARENT);
  441.     } while (defined $dir);
  442.     chop($cwd) unless $cwd eq '/'; # drop the trailing /
  443.     $cwd;
  444. }
  445.  
  446. my $Curdir;
  447. sub fast_abs_path {
  448.     local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
  449.     my $cwd = getcwd();
  450.     require File::Spec;
  451.     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
  452.  
  453.     # Detaint else we'll explode in taint mode.  This is safe because
  454.     # we're not doing anything dangerous with it.
  455.     ($path) = $path =~ /(.*)/;
  456.     ($cwd)  = $cwd  =~ /(.*)/;
  457.  
  458.     unless (-e $path) {
  459.      _croak("$path: No such file or directory");
  460.     }
  461.  
  462.     unless (-d _) {
  463.         # Make sure we can be invoked on plain files, not just directories.
  464.     
  465.     my ($vol, $dir, $file) = File::Spec->splitpath($path);
  466.     return File::Spec->catfile($cwd, $path) unless length $dir;
  467.  
  468.     if (-l $path) {
  469.         my $link_target = readlink($path);
  470.         die "Can't resolve link $path: $!" unless defined $link_target;
  471.         
  472.         $link_target = File::Spec->catpath($vol, $dir, $link_target)
  473.                 unless File::Spec->file_name_is_absolute($link_target);
  474.         
  475.         return fast_abs_path($link_target);
  476.     }
  477.     
  478.     return $dir eq File::Spec->rootdir
  479.       ? File::Spec->catpath($vol, $dir, $file)
  480.       : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
  481.     }
  482.  
  483.     if (!CORE::chdir($path)) {
  484.      _croak("Cannot chdir to $path: $!");
  485.     }
  486.     my $realpath = getcwd();
  487.     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
  488.      _croak("Cannot chdir back to $cwd: $!");
  489.     }
  490.     $realpath;
  491. }
  492.  
  493. # added function alias to follow principle of least surprise
  494. # based on previous aliasing.  --tchrist 27-Jan-00
  495. *fast_realpath = \&fast_abs_path;
  496.  
  497. # --- PORTING SECTION ---
  498.  
  499. # VMS: $ENV{'DEFAULT'} points to default directory at all times
  500. # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
  501. # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
  502. #   in the process logical name table as the default device and directory
  503. #   seen by Perl. This may not be the same as the default device
  504. #   and directory seen by DCL after Perl exits, since the effects
  505. #   the CRTL chdir() function persist only until Perl exits.
  506.  
  507. sub _vms_cwd {
  508.     return $ENV{'DEFAULT'};
  509. }
  510.  
  511. sub _vms_abs_path {
  512.     return $ENV{'DEFAULT'} unless @_;
  513.     my $path = shift;
  514.  
  515.     my $efs = _vms_efs;
  516.     my $unix_rpt = _vms_unix_rpt;
  517.  
  518.     if (defined &VMS::Filespec::vmsrealpath) {
  519.         my $path_unix = 0;
  520.         my $path_vms = 0;
  521.  
  522.         $path_unix = 1 if ($path =~ m#(?<=\^)/#);
  523.         $path_unix = 1 if ($path =~ /^\.\.?$/);
  524.         $path_vms = 1 if ($path =~ m#[\[<\]]#);
  525.         $path_vms = 1 if ($path =~ /^--?$/);
  526.  
  527.         my $unix_mode = $path_unix;
  528.         if ($efs) {
  529.             # In case of a tie, the Unix report mode decides.
  530.             if ($path_vms == $path_unix) {
  531.                 $unix_mode = $unix_rpt;
  532.             } else {
  533.                 $unix_mode = 0 if $path_vms;
  534.             }
  535.         }
  536.  
  537.         if ($unix_mode) {
  538.             # Unix format
  539.             return VMS::Filespec::unixrealpath($path);
  540.         }
  541.  
  542.     # VMS format
  543.  
  544.     my $new_path = VMS::Filespec::vmsrealpath($path);
  545.  
  546.     # Perl expects directories to be in directory format
  547.     $new_path = VMS::Filespec::pathify($new_path) if -d $path;
  548.     return $new_path;
  549.     }
  550.  
  551.     # Fallback to older algorithm if correct ones are not
  552.     # available.
  553.  
  554.     if (-l $path) {
  555.         my $link_target = readlink($path);
  556.         die "Can't resolve link $path: $!" unless defined $link_target;
  557.  
  558.         return _vms_abs_path($link_target);
  559.     }
  560.  
  561.     # may need to turn foo.dir into [.foo]
  562.     my $pathified = VMS::Filespec::pathify($path);
  563.     $path = $pathified if defined $pathified;
  564.     
  565.     return VMS::Filespec::rmsexpand($path);
  566. }
  567.  
  568. sub _os2_cwd {
  569.     $ENV{'PWD'} = `cmd /c cd`;
  570.     chomp $ENV{'PWD'};
  571.     $ENV{'PWD'} =~ s:\\:/:g ;
  572.     return $ENV{'PWD'};
  573. }
  574.  
  575. sub _win32_cwd {
  576.     if (defined &DynaLoader::boot_DynaLoader) {
  577.     $ENV{'PWD'} = Win32::GetCwd();
  578.     }
  579.     else { # miniperl
  580.     chomp($ENV{'PWD'} = `cd`);
  581.     }
  582.     $ENV{'PWD'} =~ s:\\:/:g ;
  583.     return $ENV{'PWD'};
  584. }
  585.  
  586. *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
  587.  
  588. sub _dos_cwd {
  589.     if (!defined &Dos::GetCwd) {
  590.         $ENV{'PWD'} = `command /c cd`;
  591.         chomp $ENV{'PWD'};
  592.         $ENV{'PWD'} =~ s:\\:/:g ;
  593.     } else {
  594.         $ENV{'PWD'} = Dos::GetCwd();
  595.     }
  596.     return $ENV{'PWD'};
  597. }
  598.  
  599. sub _qnx_cwd {
  600.     local $ENV{PATH} = '';
  601.     local $ENV{CDPATH} = '';
  602.     local $ENV{ENV} = '';
  603.     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
  604.     chomp $ENV{'PWD'};
  605.     return $ENV{'PWD'};
  606. }
  607.  
  608. sub _qnx_abs_path {
  609.     local $ENV{PATH} = '';
  610.     local $ENV{CDPATH} = '';
  611.     local $ENV{ENV} = '';
  612.     my $path = @_ ? shift : '.';
  613.     local *REALPATH;
  614.  
  615.     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
  616.       die "Can't open /usr/bin/fullpath: $!";
  617.     my $realpath = <REALPATH>;
  618.     close REALPATH;
  619.     chomp $realpath;
  620.     return $realpath;
  621. }
  622.  
  623. sub _epoc_cwd {
  624.     $ENV{'PWD'} = EPOC::getcwd();
  625.     return $ENV{'PWD'};
  626. }
  627.  
  628. # Now that all the base-level functions are set up, alias the
  629. # user-level functions to the right places
  630.  
  631. if (exists $METHOD_MAP{$^O}) {
  632.   my $map = $METHOD_MAP{$^O};
  633.   foreach my $name (keys %$map) {
  634.     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
  635.     no strict 'refs';
  636.     *{$name} = \&{$map->{$name}};
  637.   }
  638. }
  639.  
  640. # In case the XS version doesn't load.
  641. *abs_path = \&_perl_abs_path unless defined &abs_path;
  642. *getcwd = \&_perl_getcwd unless defined &getcwd;
  643.  
  644. # added function alias for those of us more
  645. # used to the libc function.  --tchrist 27-Jan-00
  646. *realpath = \&abs_path;
  647.  
  648. 1;
  649.